home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / dc174v11.zip / RSB1DROP.MRG < prev    next >
Text File  |  1992-07-18  |  10KB  |  198 lines

  1. * ------------[ BLED merge (c) Ken Goosens ]-------------
  2. * Merge this against RBBSSUB1.BAS to produce RBBSSUB1.NEW
  3. * RBBSSUB1.BAS:  Date 6-20-1992  Size 55569 bytes
  4. *          DROP174 (c) 1992 by Richie Molinelli
  5. * ------------[ Created 07-18-1992 02:19:31 ]------------
  6. * REPLACING old line(s) by new
  7. ' $linesize:132
  8. ' $title: 'RBBS-SUB1.BAS 17.4, Copyright 1986-92 by D. Thomas Mack'
  9. '  Copyright 1990 by D. Thomas Mack, all rights reserved.
  10. '  Name ...............: RBBSSUB1.BAS
  11. '  First Released .....: June 21, 1992
  12. '  Subsequent Releases.: 
  13. '  Copyright ..........: 1986-1992
  14. '  Purpose.............:
  15. '     Subprorams that require error trapping are incorporated
  16. '     within RBBSSUB1.BAS as separately callable subroutines
  17. '     in order to free up as much code as possible within
  18. '     the 64WasK code segment used by RBBS-PC.BAS.
  19. '  Parameters..........: Most parameters are passed via a COMMON statement.
  20. '
  21. ' Subroutine  Line               Function of Subroutine
  22. '   Name     Number
  23. '  ChangeDir   20101   Change subdirectory
  24. '  CheckInt    58360   Check input is valid integer
  25. '  CommPut     59275   Write string to communications port
  26. * ------[ first line different ]------
  27. '  DropCarrier 63901   Change users security level with excessive carrier drops ' DROP174
  28. '  FindFile    59790   Determine whether a file exists without opening it
  29. '  FindFree    51098   Find amount of space on the upload disk drive
  30. '  FindItX     20219   Find if a file exists on a device
  31. '  FindUser    12598   Find a user in the USERS file
  32. '  FlushCom    20308   Read all characters in the communications port
  33. '  GetCom       1418   Read a character from the communications port
  34. '  GetPassword 58280   Read RBBS-PC's "PASSWORD" file
  35. '  GETWRK      58330   Read record from file number 2
  36. '  KillWork    58258   Delete a RBBS-PC "WORK" file
  37. '  NetBIOS     20898   Lock/Unlock NetBIOS semaphore files
  38. '  OpenCom       200   Open communications port (number 3)
  39. '  OpenFMS     58188   Open the upload management system directory
  40. '  OpenOutW    28218   Open RBBS-PC's "WORK" file (number 2) for output
  41. '  OpenRSeq     1479   Open a sequential file (number 2) for random I/O
  42. '  OpenUser     9398   Open the USER file (number 5)
  43. '  OpenWork    57978   Open RBBS-PC's work file (number 2)
  44. '  OpenWorkA   58340   Open RBBS-PC's "WORK" file (number 2) for append
  45. '  Printit     13673   Print line on the local PC printer
  46. '  PrintWork   58320   Print string to file #2 w/o CR/LF
  47. '  PrintWorkA  58350   Print string to file #2 with CR/LF
  48. '  PutCom      59650   Write to the communications port
  49. '  PutWork     59660   Write to work file randomly
  50. '  RBBSPlay    59680   Plays a musical string
  51. '  ReadAny     58310   Read file number 2 into ZOutTxt$
  52. '  ReadDef       112   Read configuration file
  53. '  ReadDir     58290   Read entire lines
  54. '  ReadParmsX  58300   Read certain number of parameters from specified file
  55. '  Talk        59700   RBBS-PC Voice synthesizer support for sight impaired
  56. '  SetCall       108   Find where next callers record is
  57. '  UpdateC     43048   Update the caller's file with elasped session time
  58. '  UpdtCalr    13661   Update to the caller's file
  59. '
  60. '  $INCLUDE: 'RBBS-VAR.BAS'
  61. '
  62. * REPLACING old line(s) by new
  63. 9400 CLOSE 5
  64.      IF ZShareIt THEN _
  65.         OPEN ZActiveUserFile$ FOR RANDOM SHARED AS #5 LEN=128 _
  66.      ELSE OPEN "R",5,ZActiveUserFile$,128
  67.      WasI# = LOF(5)
  68.      LastRec = FIX(WasI#/128)
  69.      FIELD 5,31 AS ZUserName$, _
  70.              15 AS ZPswd$, _
  71.               2 AS ZSecLevel$, _
  72.              14 AS ZUserOption$,  _
  73.              24 AS ZCityState$, _
  74. * ------[ first line different ]------
  75.               1 AS MachineType$, _                                   ' DROP174
  76.               1 AS ZDropTimes$, _                                    ' DROP174
  77.               1 AS ZBankTime$,_
  78.               4 AS ZTodayDl$, _
  79.               4 AS ZTodayBytes$, _
  80.               4 AS ZDlBytes$, _
  81.               4 AS ZULBytes$, _
  82.              14 AS ZLastDateTimeOn$, _
  83.               3 AS ZListNewDate$, _
  84.               2 AS ZUserDnlds$, _
  85.               2 AS ZUserUplds$, _
  86.               2 AS ZElapsedTime$
  87.      FIELD 5,128 AS ZUserRecord$
  88.      END SUB
  89. * REPLACING old line(s) by new
  90. 58280 ' $SUBTITLE: 'GetPassword - sub to read the "passwords" file'
  91. ' $PAGE
  92. '
  93. '  NAME    -- GetPassword
  94. '
  95. '                          PARAMETER             MEANING
  96. '  INPUTS  -- FILE # 2 OPENED
  97. '
  98. '  OUTPUTS -- ZTempPassword$
  99. '             ZTempSecLevel
  100. '             ZTempTimeAllowed
  101. '             ZTempRegPeriod
  102. '             ZTempMaxPerDay
  103. '
  104. '  PURPOSE -- To read the RBBS-PC "PASSWORDS" file
  105. '
  106.       SUB GetPassword STATIC
  107.       ON ERROR GOTO 65000
  108.       ZErrCode = 0
  109.       INPUT #2,ZTempPassword$,    ZTempSecLevel, _
  110.                ZTempTimeAllowed,  ZTempMaxPerDay, _
  111.                ZTempRegPeriod,    ZTempExpiredSec, _
  112.                ZStartTime,        ZEndTime, _
  113.                ZByteMethod,       ZRatioRestrict#, _
  114.                ZInitialCredit#,   ZTempTimeLock, _
  115. * ------[ first line different ]------
  116.                ZTempMaxBank,      ZDropCarSecChng, _                 ' DROP174
  117.                ZDropIncrement                                        ' DROP174
  118. * REPLACING old line(s) by new
  119. 59790 ' $SUBTITLE: 'FindFile -- subroutine to find a file'
  120. ' $PAGE
  121. '
  122. '  NAME    --  FindFile
  123. '
  124. '  INPUTS  --  PARAMETER         MENANING
  125. '               FilName$         NAME OF FILE TO LOOK FOR
  126. '               FExists          WHETHER FILE EXISTS
  127. '
  128. '  OUTPUTS --  RETURNED.VALUE    VALUE RETURNED
  129. '                                TRUE  = FILE EXISTS
  130. '                                TRUE = FILE DOES NOT EXIST
  131. '
  132. '  PURPOSE --  Determine whether passed file FilName$ exists
  133. '              Unlike, FindIt, this routine does not open any
  134. '              file and, hence, does not create one in determining
  135. '              whether a file exists.
  136. '
  137.       SUB FindFile (FilName$,FExists) STATIC
  138.       CALL BadFileChar (FilName$,FExists)
  139. 59791 IF FExists THEN _
  140.          IOErrorCount = 0 : _
  141.          CALL RBBSFind (FilName$,WasZ,WasY,WasM,WasD) : _
  142.          FExists = (WasZ = 0)
  143.       END SUB
  144. * ------[ first line different ]------
  145. * INSERTING new line(s)
  146. '                                                                    ' DROP174
  147. 63901 '$SUBTITLE: 'DropCarrier -- Subroutine to change users sec level' ' DROP174
  148. ' $PAGE                                                              ' DROP174
  149. '                                                                    ' DROP174
  150. ' NAME: DropCarrier                                                  ' DROP174
  151. '                                                                    ' DROP174
  152. ' PURPOSE: To change a users security level who is dropping carrier  ' DROP174
  153. '          excessively                                               ' DROP174
  154. '                                                                    ' DROP174
  155. ' INPUTS:  ZDropCarSecChng                                           ' DROP174
  156. '          ZDropIncrement                                            ' DROP174
  157. '          ZDropTimes                                                ' DROP174
  158. '                                                                    ' DROP174
  159. ' WRITTEN BY: Richie Molinelli - 7/12/92                             ' DROP174
  160. '                                                                    ' DROP174
  161.       SUB DropCarrier STATIC                                         ' DROP174
  162. 63902 IF ZDropCarSecChng = 0 THEN _                                  ' DROP174
  163.          EXIT SUB                                                    ' DROP174
  164.       IF ZDropTimes > ZDropCarSecChng THEN _                         ' DROP174
  165.          ZDropTimes = ZDropCarSecChng - 1                            ' DROP174
  166.       IF ZDropChange = ZFalse THEN                                   ' DROP174
  167.          ZDropTimes = ZDropTimes + 1                                 ' DROP174
  168.          IF ZDropTimes MOD ZDropCarSecChng <> 0 THEN                 ' DROP174
  169.             ZGlobalDropTimes = ZDropTimes                            ' DROP174
  170.             ZDropChange = ZTrue                                      ' DROP174
  171.             EXIT SUB                                                 ' DROP174
  172.          END IF                                                      ' DROP174
  173.          ZUserSecLevel = ZUserSecLevel - ZDropIncrement              ' DROP174
  174.          ZSubParm = 6                                                ' DROP174
  175.          CALL FileLock                                               ' DROP174
  176.          CALL OpenUser (HighestUserRecord)                           ' DROP174
  177.          GET 5,ZUserFileIndex                                        ' DROP174
  178.          LSET ZSecLevel$ = MKI$(ZUserSecLevel)                       ' DROP174
  179.          IF ZUserFileIndex > 0 AND ZUserFileIndex < 32768 THEN _     ' DROP174
  180.             PUT 5,ZUserFileIndex                                     ' DROP174
  181.          ZSubParm = 8                                                ' DROP174
  182.          CALL FileLock                                               ' DROP174
  183.          ZDropChange = ZTrue                                         ' DRIP174
  184.          CALL UpdtCalr ("Security reset for Dropped Carriers!",2)    ' DROP174
  185.          ZDropTimes = 0                                              ' DROP174
  186.          ZGlobalDropTimes = ZDropTimes                               ' DROP174
  187.          ZSubParm = -1                                               ' DROP174
  188.       END IF                                                         ' DROP174
  189.       END SUB                                                        ' DROP174
  190. '                                                                    ' DROP174
  191. '  $SUBTITLE: 'Error Handling for separately compiled subroutines'
  192. '  $PAGE
  193. '
  194. '
  195. ' Error handling for the separately compiled subroutines of RBBS-PC
  196. '
  197. '
  198.